/*
** $Id: lbaselib.c,v 1.314 2016/09/05 19:06:34 roberto Exp $
** Basic library
** See Copyright Notice in lua.h
*/

#define lbaselib_c
#define LUA_LIB

#include "lprefix.h"


#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "lua.h"

#include "lauxlib.h"
#include "lualib.h"


static int luaB_print( lua_State* L ) {
    int n = lua_gettop( L ); /* number of arguments */
    int i;
    lua_getglobal( L, "tostring" );

    for ( i = 1; i <= n; i++ ) {
        const char* s;
        size_t l;
        lua_pushvalue( L, -1 ); /* function to be called */
        lua_pushvalue( L, i ); /* value to print */
        lua_call( L, 1, 1 );
        s = lua_tolstring( L, -1, &l ); /* get result */

        if ( s == NULL ) {
            return luaL_error( L, "'tostring' must return a string to 'print'" );
        }

        if ( i > 1 ) {
            lua_writestring( "\t", 1 );
        }

        lua_writestring( s, l );
        lua_pop( L, 1 ); /* pop result */
    }

    lua_writeline();
    return 0;
}


#define SPACECHARS  " \f\n\r\t\v"

static const char* b_str2int( const char* s, int base, lua_Integer* pn ) {
    lua_Unsigned n = 0;
    int neg = 0;
    s += strspn( s, SPACECHARS ); /* skip initial spaces */

    if ( *s == '-' ) {
        s++;    /* handle signal */
        neg = 1;
    }
    else if ( *s == '+' ) {
        s++;
    }

    if ( !isalnum( ( unsigned char )*s ) ) { /* no digit? */
        return NULL;
    }

    do {
        int digit = ( isdigit( ( unsigned char ) * s ) ) ? *s - '0'
                    : ( toupper( ( unsigned char ) * s ) - 'A' ) + 10;

        if ( digit >= base ) {
            return NULL;    /* invalid numeral */
        }

        n = n * base + digit;
        s++;
    }
    while ( isalnum( ( unsigned char )*s ) );

    s += strspn( s, SPACECHARS ); /* skip trailing spaces */
    *pn = ( lua_Integer )( ( neg ) ? ( 0u - n ) : n );
    return s;
}


static int luaB_tonumber( lua_State* L ) {
    if ( lua_isnoneornil( L, 2 ) ) { /* standard conversion? */
        luaL_checkany( L, 1 );

        if ( lua_type( L, 1 ) == LUA_TNUMBER ) { /* already a number? */
            lua_settop( L, 1 ); /* yes; return it */
            return 1;
        }
        else {
            size_t l;
            const char* s = lua_tolstring( L, 1, &l );

            if ( s != NULL && lua_stringtonumber( L, s ) == l + 1 ) {
                return 1;    /* successful conversion to number */
            }

            /* else not a number */
        }
    }
    else {
        size_t l;
        const char* s;
        lua_Integer n = 0;  /* to avoid warnings */
        lua_Integer base = luaL_checkinteger( L, 2 );
        luaL_checktype( L, 1, LUA_TSTRING ); /* no numbers as strings */
        s = lua_tolstring( L, 1, &l );
        luaL_argcheck( L, 2 <= base && base <= 36, 2, "base out of range" );

        if ( b_str2int( s, ( int )base, &n ) == s + l ) {
            lua_pushinteger( L, n );
            return 1;
        }  /* else not a number */
    }  /* else not a number */

    lua_pushnil( L ); /* not a number */
    return 1;
}


static int luaB_error( lua_State* L ) {
    int level = ( int )luaL_optinteger( L, 2, 1 );
    lua_settop( L, 1 );

    if ( lua_type( L, 1 ) == LUA_TSTRING && level > 0 ) {
        luaL_where( L, level ); /* add extra information */
        lua_pushvalue( L, 1 );
        lua_concat( L, 2 );
    }

    return lua_error( L );
}


static int luaB_getmetatable( lua_State* L ) {
    luaL_checkany( L, 1 );

    if ( !lua_getmetatable( L, 1 ) ) {
        lua_pushnil( L );
        return 1;  /* no metatable */
    }

    luaL_getmetafield( L, 1, "__metatable" );
    return 1;  /* returns either __metatable field (if present) or metatable */
}


static int luaB_setmetatable( lua_State* L ) {
    int t = lua_type( L, 2 );
    luaL_checktype( L, 1, LUA_TTABLE );
    luaL_argcheck( L, t == LUA_TNIL || t == LUA_TTABLE, 2,
                   "nil or table expected" );

    if ( luaL_getmetafield( L, 1, "__metatable" ) != LUA_TNIL ) {
        return luaL_error( L, "cannot change a protected metatable" );
    }

    lua_settop( L, 2 );
    lua_setmetatable( L, 1 );
    return 1;
}


static int luaB_rawequal( lua_State* L ) {
    luaL_checkany( L, 1 );
    luaL_checkany( L, 2 );
    lua_pushboolean( L, lua_rawequal( L, 1, 2 ) );
    return 1;
}


static int luaB_rawlen( lua_State* L ) {
    int t = lua_type( L, 1 );
    luaL_argcheck( L, t == LUA_TTABLE || t == LUA_TSTRING, 1,
                   "table or string expected" );
    lua_pushinteger( L, lua_rawlen( L, 1 ) );
    return 1;
}


static int luaB_rawget( lua_State* L ) {
    luaL_checktype( L, 1, LUA_TTABLE );
    luaL_checkany( L, 2 );
    lua_settop( L, 2 );
    lua_rawget( L, 1 );
    return 1;
}

static int luaB_rawset( lua_State* L ) {
    luaL_checktype( L, 1, LUA_TTABLE );
    luaL_checkany( L, 2 );
    luaL_checkany( L, 3 );
    lua_settop( L, 3 );
    lua_rawset( L, 1 );
    return 1;
}


static int luaB_collectgarbage( lua_State* L ) {
    static const char* const opts[] = {"stop", "restart", "collect",
                                       "count", "step", "setpause", "setstepmul",
                                       "isrunning", NULL
                                      };
    static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
                                  LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL,
                                  LUA_GCISRUNNING
                                 };
    int o = optsnum[luaL_checkoption( L, 1, "collect", opts )];
    int ex = ( int )luaL_optinteger( L, 2, 0 );
    int res = lua_gc( L, o, ex );

    switch ( o ) {
    case LUA_GCCOUNT: {
        int b = lua_gc( L, LUA_GCCOUNTB, 0 );
        lua_pushnumber( L, ( lua_Number )res + ( ( lua_Number )b / 1024 ) );
        return 1;
    }

    case LUA_GCSTEP:
    case LUA_GCISRUNNING: {
        lua_pushboolean( L, res );
        return 1;
    }

    default: {
        lua_pushinteger( L, res );
        return 1;
    }
    }
}


static int luaB_type( lua_State* L ) {
    int t = lua_type( L, 1 );
    luaL_argcheck( L, t != LUA_TNONE, 1, "value expected" );
    lua_pushstring( L, lua_typename( L, t ) );
    return 1;
}


static int pairsmeta( lua_State* L, const char* method, int iszero,
                      lua_CFunction iter ) {
    luaL_checkany( L, 1 );

    if ( luaL_getmetafield( L, 1, method ) == LUA_TNIL ) { /* no metamethod? */
        lua_pushcfunction( L, iter ); /* will return generator, */
        lua_pushvalue( L, 1 ); /* state, */

        if ( iszero ) {
            lua_pushinteger( L, 0 );    /* and initial value */
        }
        else {
            lua_pushnil( L );
        }
    }
    else {
        lua_pushvalue( L, 1 ); /* argument 'self' to metamethod */
        lua_call( L, 1, 3 ); /* get 3 values from metamethod */
    }

    return 3;
}


static int luaB_next( lua_State* L ) {
    luaL_checktype( L, 1, LUA_TTABLE );
    lua_settop( L, 2 ); /* create a 2nd argument if there isn't one */

    if ( lua_next( L, 1 ) ) {
        return 2;
    }
    else {
        lua_pushnil( L );
        return 1;
    }
}


static int luaB_pairs( lua_State* L ) {
    return pairsmeta( L, "__pairs", 0, luaB_next );
}


/*
** Traversal function for 'ipairs'
*/
static int ipairsaux( lua_State* L ) {
    lua_Integer i = luaL_checkinteger( L, 2 ) + 1;
    lua_pushinteger( L, i );
    return ( lua_geti( L, 1, i ) == LUA_TNIL ) ? 1 : 2;
}


/*
** 'ipairs' function. Returns 'ipairsaux', given "table", 0.
** (The given "table" may not be a table.)
*/
static int luaB_ipairs( lua_State* L ) {
#if defined(LUA_COMPAT_IPAIRS)
    return pairsmeta( L, "__ipairs", 1, ipairsaux );
#else
    luaL_checkany( L, 1 );
    lua_pushcfunction( L, ipairsaux ); /* iteration function */
    lua_pushvalue( L, 1 ); /* state */
    lua_pushinteger( L, 0 ); /* initial value */
    return 3;
#endif
}


static int load_aux( lua_State* L, int status, int envidx ) {
    if ( status == LUA_OK ) {
        if ( envidx != 0 ) { /* 'env' parameter? */
            lua_pushvalue( L, envidx ); /* environment for loaded function */

            if ( !lua_setupvalue( L, -2, 1 ) ) { /* set it as 1st upvalue */
                lua_pop( L, 1 );    /* remove 'env' if not used by previous call */
            }
        }

        return 1;
    }
    else {   /* error (message is on top of the stack) */
        lua_pushnil( L );
        lua_insert( L, -2 ); /* put before error message */
        return 2;  /* return nil plus error message */
    }
}


static int luaB_loadfile( lua_State* L ) {
    const char* fname = luaL_optstring( L, 1, NULL );
    const char* mode = luaL_optstring( L, 2, NULL );
    int env = ( !lua_isnone( L, 3 ) ? 3 : 0 ); /* 'env' index or 0 if no 'env' */
    int status = luaL_loadfilex( L, fname, mode );
    return load_aux( L, status, env );
}


/*
** {======================================================
** Generic Read function
** =======================================================
*/


/*
** reserved slot, above all arguments, to hold a copy of the returned
** string to avoid it being collected while parsed. 'load' has four
** optional arguments (chunk, source name, mode, and environment).
*/
#define RESERVEDSLOT    5


/*
** Reader for generic 'load' function: 'lua_load' uses the
** stack for internal stuff, so the reader cannot change the
** stack top. Instead, it keeps its resulting string in a
** reserved slot inside the stack.
*/
static const char* generic_reader( lua_State* L, void* ud, size_t* size ) {
    ( void )( ud ); /* not used */
    luaL_checkstack( L, 2, "too many nested functions" );
    lua_pushvalue( L, 1 ); /* get function */
    lua_call( L, 0, 1 ); /* call it */

    if ( lua_isnil( L, -1 ) ) {
        lua_pop( L, 1 ); /* pop result */
        *size = 0;
        return NULL;
    }
    else if ( !lua_isstring( L, -1 ) ) {
        luaL_error( L, "reader function must return a string" );
    }

    lua_replace( L, RESERVEDSLOT ); /* save string in reserved slot */
    return lua_tolstring( L, RESERVEDSLOT, size );
}


static int luaB_load( lua_State* L ) {
    int status;
    size_t l;
    const char* s = lua_tolstring( L, 1, &l );
    const char* mode = luaL_optstring( L, 3, "bt" );
    int env = ( !lua_isnone( L, 4 ) ? 4 : 0 ); /* 'env' index or 0 if no 'env' */

    if ( s != NULL ) { /* loading a string? */
        const char* chunkname = luaL_optstring( L, 2, s );
        status = luaL_loadbufferx( L, s, l, chunkname, mode );
    }
    else {   /* loading from a reader function */
        const char* chunkname = luaL_optstring( L, 2, "=(load)" );
        luaL_checktype( L, 1, LUA_TFUNCTION );
        lua_settop( L, RESERVEDSLOT ); /* create reserved slot */
        status = lua_load( L, generic_reader, NULL, chunkname, mode );
    }

    return load_aux( L, status, env );
}

/* }====================================================== */


static int dofilecont( lua_State* L, int d1, lua_KContext d2 ) {
    ( void )d1;
    ( void )d2; /* only to match 'lua_Kfunction' prototype */
    return lua_gettop( L ) - 1;
}


static int luaB_dofile( lua_State* L ) {
    const char* fname = luaL_optstring( L, 1, NULL );
    lua_settop( L, 1 );

    if ( luaL_loadfile( L, fname ) != LUA_OK ) {
        return lua_error( L );
    }

    lua_callk( L, 0, LUA_MULTRET, 0, dofilecont );
    return dofilecont( L, 0, 0 );
}


static int luaB_assert( lua_State* L ) {
    if ( lua_toboolean( L, 1 ) ) { /* condition is true? */
        return lua_gettop( L );    /* return all arguments */
    }
    else {  /* error */
        luaL_checkany( L, 1 ); /* there must be a condition */
        lua_remove( L, 1 ); /* remove it */
        lua_pushliteral( L, "assertion failed!" ); /* default message */
        lua_settop( L, 1 ); /* leave only message (default if no other one) */
        return luaB_error( L ); /* call 'error' */
    }
}


static int luaB_select( lua_State* L ) {
    int n = lua_gettop( L );

    if ( lua_type( L, 1 ) == LUA_TSTRING && *lua_tostring( L, 1 ) == '#' ) {
        lua_pushinteger( L, n - 1 );
        return 1;
    }
    else {
        lua_Integer i = luaL_checkinteger( L, 1 );

        if ( i < 0 ) {
            i = n + i;
        }
        else if ( i > n ) {
            i = n;
        }

        luaL_argcheck( L, 1 <= i, 1, "index out of range" );
        return n - ( int )i;
    }
}


/*
** Continuation function for 'pcall' and 'xpcall'. Both functions
** already pushed a 'true' before doing the call, so in case of success
** 'finishpcall' only has to return everything in the stack minus
** 'extra' values (where 'extra' is exactly the number of items to be
** ignored).
*/
static int finishpcall( lua_State* L, int status, lua_KContext extra ) {
    if ( status != LUA_OK && status != LUA_YIELD ) { /* error? */
        lua_pushboolean( L, 0 ); /* first result (false) */
        lua_pushvalue( L, -2 ); /* error message */
        return 2;  /* return false, msg */
    }
    else {
        return lua_gettop( L ) - ( int )extra;    /* return all results */
    }
}


static int luaB_pcall( lua_State* L ) {
    int status;
    luaL_checkany( L, 1 );
    lua_pushboolean( L, 1 ); /* first result if no errors */
    lua_insert( L, 1 ); /* put it in place */
    status = lua_pcallk( L, lua_gettop( L ) - 2, LUA_MULTRET, 0, 0, finishpcall );
    return finishpcall( L, status, 0 );
}


/*
** Do a protected call with error handling. After 'lua_rotate', the
** stack will have <f, err, true, f, [args...]>; so, the function passes
** 2 to 'finishpcall' to skip the 2 first values when returning results.
*/
static int luaB_xpcall( lua_State* L ) {
    int status;
    int n = lua_gettop( L );
    luaL_checktype( L, 2, LUA_TFUNCTION ); /* check error function */
    lua_pushboolean( L, 1 ); /* first result */
    lua_pushvalue( L, 1 ); /* function */
    lua_rotate( L, 3, 2 ); /* move them below function's arguments */
    status = lua_pcallk( L, n - 2, LUA_MULTRET, 2, 2, finishpcall );
    return finishpcall( L, status, 2 );
}


static int luaB_tostring( lua_State* L ) {
    luaL_checkany( L, 1 );
    luaL_tolstring( L, 1, NULL );
    return 1;
}


static const luaL_Reg base_funcs[] = {
    {"assert", luaB_assert},
    {"collectgarbage", luaB_collectgarbage},
    {"dofile", luaB_dofile},
    {"error", luaB_error},
    {"getmetatable", luaB_getmetatable},
    {"ipairs", luaB_ipairs},
    {"loadfile", luaB_loadfile},
    {"load", luaB_load},
#if defined(LUA_COMPAT_LOADSTRING)
    {"loadstring", luaB_load},
#endif
    {"next", luaB_next},
    {"pairs", luaB_pairs},
    {"pcall", luaB_pcall},
    {"print", luaB_print},
    {"rawequal", luaB_rawequal},
    {"rawlen", luaB_rawlen},
    {"rawget", luaB_rawget},
    {"rawset", luaB_rawset},
    {"select", luaB_select},
    {"setmetatable", luaB_setmetatable},
    {"tonumber", luaB_tonumber},
    {"tostring", luaB_tostring},
    {"type", luaB_type},
    {"xpcall", luaB_xpcall},
    /* placeholders */
    {"_G", NULL},
    {"_VERSION", NULL},
    {NULL, NULL}
};


LUAMOD_API int luaopen_base( lua_State* L ) {
    /* open lib into global table */
    lua_pushglobaltable( L );
    luaL_setfuncs( L, base_funcs, 0 );
    /* set global _G */
    lua_pushvalue( L, -1 );
    lua_setfield( L, -2, "_G" );
    /* set global _VERSION */
    lua_pushliteral( L, LUA_VERSION );
    lua_setfield( L, -2, "_VERSION" );
    return 1;
}

